home *** CD-ROM | disk | FTP | other *** search
Wrap
VERSION 2.00 Begin Form Atomic BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "Call the Atomic Clock" ClientHeight = 3915 ClientLeft = 2460 ClientTop = 930 ClientWidth = 4725 Height = 4320 Left = 2400 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3915 ScaleWidth = 4725 Top = 585 Width = 4845 Begin MSComm Comm1 Interval = 1000 Left = 3390 Top = 1125 End Begin SSCheck DST Caption = "Use Daylight Savings Time" Font3D = 0 'None Height = 285 Left = 225 TabIndex = 4 Top = 960 Width = 2640 End Begin ComboBox TimeZone BackColor = &H00FFFFFF& Height = 300 Left = 375 Style = 2 'Dropdown List TabIndex = 3 Top = 450 Width = 4065 End Begin CommandButton Command1 Cancel = -1 'True Caption = "Cancel" Height = 345 Index = 2 Left = 2370 TabIndex = 1 Top = 3300 Width = 2085 End Begin CommandButton Command1 Caption = "Dial" Default = -1 'True Height = 345 Index = 1 Left = 2370 TabIndex = 0 Top = 2790 Width = 2070 End Begin CommandButton Command1 Caption = "Reset Defaults" Height = 345 Index = 0 Left = 2370 TabIndex = 12 Top = 2280 Width = 2070 End Begin SSFrame Frame3D1 Caption = "COM Port" Font3D = 0 'None ForeColor = &H00000000& Height = 1530 Left = 255 TabIndex = 7 Top = 2190 Width = 1965 Begin SSOption ComPort Caption = "COM&4:" Font3D = 0 'None ForeColor = &H00000000& Height = 240 Index = 3 Left = 135 TabIndex = 11 Top = 1185 Width = 780 End Begin SSOption ComPort Caption = "COM&3:" Font3D = 0 'None ForeColor = &H00000000& Height = 240 Index = 2 Left = 135 TabIndex = 10 Top = 885 Width = 780 End Begin SSOption ComPort Caption = "COM&2:" Font3D = 0 'None ForeColor = &H00000000& Height = 240 Index = 1 Left = 135 TabIndex = 9 Top = 585 Width = 780 End Begin SSOption ComPort Caption = "COM&1:" Font3D = 0 'None ForeColor = &H00000000& Height = 240 Index = 0 Left = 135 TabIndex = 8 Top = 285 Width = 780 End End Begin TextBox DialString Height = 300 Left = 375 TabIndex = 6 Text = "ATDT 1 303 494-4774" Top = 1710 Width = 4080 End Begin Label Status Alignment = 1 'Right Justify BackStyle = 0 'Transparent Height = 240 Left = 1125 TabIndex = 13 Top = 15 Width = 3300 End Begin Label Label1 BackStyle = 0 'Transparent Caption = "Modem Dial String" Height = 210 Index = 1 Left = 225 TabIndex = 5 Top = 1440 Width = 2145 End Begin Label Label1 BackStyle = 0 'Transparent Caption = "Time Zone" Height = 240 Index = 0 Left = 195 TabIndex = 2 Top = 165 Width = 1320 End Option Explicit Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer Dim ControlsDisabled As Integer Dim InString As String Dim TString As String Dim Aborted As Integer Sub Command1_Click (Index As Integer) Dim StartTime As Double Dim I As Integer Dim NewD As Double Dim OldD As Double Dim DSTFlag As String Dim OffBy As String If Index = 0 Then 'Reset Defaults ResetDefaults Status.Caption = "" End If If Index = 1 Then 'Dial SaveModemSettings Aborted = False Status.Caption = "" Command1(0).Enabled = False Command1(1).Enabled = False TimeZone.Enabled = False DST.Enabled = False DialString.Enabled = False Frame3D1.Enabled = False ControlsDisabled = True On Local Error GoTo ErrHndl For I% = 0 To 3 If ComPort(I%).Value Then comm1.CommPort = I% + 1 Next I% If Aborted Then Exit Sub comm1.Settings = "1200,N,8,1" If Aborted Then Exit Sub comm1.PortOpen = True If Aborted Then Exit Sub comm1.Output = DialString.Text + Chr$(13) + Chr(10) StartTime = Timer LastTime = 0 Do DoEvents If LastTime <> Int(Timer) Then If Not Aborted Then Status.Caption = "Connecting - " + Format$(45 - Int(Timer - StartTime)) + " seconds until timeout." LastTime = Int(Timer) End If Loop Until comm1.InBufferCount >= 600 Or ((Timer - StartTime) > 45) Or Aborted If Aborted Then Exit Sub If (Timer - StartTime) > 45 Then Status.Caption = "Timed out." Exit Sub End If Status.Caption = "Setting time." InString$ = comm1.Input If Aborted Then Exit Sub InString$ = Mid$(InString$, InStr(InString$, "*") + 1, 80) NewD = DateValue(Mid$(InString$, 12, 2) + "/" + Mid$(InString$, 15, 2) + "/" + Mid$(InString$, 9, 2)) NewD = NewD + TimeValue(Mid$(InString$, 18, 8)) NewD = NewD - (TimeZone.ListIndex - 11) * (1 / 24) DSTFlag$ = Mid$(InString$, 27, 2) If ((DSTFlag >= "01") And (DSTFlag <= "50")) Then NewD = NewD - (1 / 24) End If If DST.Value Then NewD = NewD + (1 / 24) End If OldD = Date + Time If Year(NewD) >= 1993 Then Date = Format$(NewD, "mm/dd/yy") Time = Format$(NewD, "hh:mm:ss") If OldD > NewD Then OffBy = "fast" Else OffBy = "slow" End If MsgBox "Time set to " + Format$(NewD, "hh:mm:ss") + ". Clock was " + OffBy$ + " by " + Format$(Abs(NewD - OldD), "hh:mm:ss") + "." AtomicTimeWasSet = True Status.Caption = "Time set." Else MsgBox "Error getting date and time." End If If Aborted Then Exit Sub HangUp If Aborted Then Exit Sub On Local Error Resume Next Unload Atomic End If If Index = 2 Then 'Cancel If ControlsDisabled Then HangUp EnableControls Aborted = True Status.Caption = "Aborted." Else Unload Atomic End If End If EnableControls Exit Sub ErrHndl: MsgBox "Error: " + Error(Err) EnableControls Exit Sub End Sub Sub EnableControls () Command1(0).Enabled = True Command1(1).Enabled = True TimeZone.Enabled = True DST.Enabled = True DialString.Enabled = True Frame3D1.Enabled = True ControlsDisabled = False End Sub Sub Form_Load () Atomic.Left = Settings.Left + (Settings.Width / 2) - (Atomic.Width / 2) Atomic.Top = Settings.Top + (Settings.Height / 2) - (Atomic.Height / 2) TimeZone.AddItem "Greenwich + 11" TimeZone.AddItem "Greenwich + 10" TimeZone.AddItem "Greenwich + 9" TimeZone.AddItem "Greenwich + 8" TimeZone.AddItem "Greenwich + 7" TimeZone.AddItem "Greenwich + 6" TimeZone.AddItem "Greenwich + 5" TimeZone.AddItem "Greenwich + 4" TimeZone.AddItem "Greenwich + 3" TimeZone.AddItem "Greenwich + 2" TimeZone.AddItem "Greenwich + 1" TimeZone.AddItem "Greenwich" TimeZone.AddItem "Greenwich - 1" TimeZone.AddItem "Greenwich - 2" TimeZone.AddItem "Greenwich - 3" TimeZone.AddItem "Atlantic Standard Time (4)" TimeZone.AddItem "Eastern Standard Time" TimeZone.AddItem "Central Time" TimeZone.AddItem "Mountain Time" TimeZone.AddItem "Pacific Time" TimeZone.AddItem "Yukon Standard Time" TimeZone.AddItem "Alaska-Hawaii Standard Time" TimeZone.AddItem "Nome Standard Time" TimeZone.AddItem "Greenwich - 12" ResetDefaults LoadModemSettings 'Atomic.Show 1 'Command1(1).SetFocus End Sub Sub HangUp () Dim StartTime As Double Dim I As Integer Dim Ret As Integer 'Beep On Local Error GoTo ErrHndl2 'comm1.Output = "+++" 'StartTime = Timer 'While Timer - StartTime < .5 ' DoEvents 'Wend 'comm1.Output = "ATH0" + Chr$(13) + Chr(10) For I% = 1 To 3 StartTime = Timer TString$ = comm1.Input comm1.Output = "+" While Timer - StartTime < .5 DoEvents Wend Next I% 'Do ' DoEvents 'Loop Until comm1.InBufferCount >= 2 comm1.Output = "ATH0" + Chr(13) + Chr(10) StartTime = Timer Do DoEvents Loop Until comm1.InBufferCount >= 2 Or (Timer - StartTime) > 5 TString$ = comm1.Input comm1.Output = "+++" StartTime = Timer While Timer - StartTime < .5 DoEvents Wend comm1.Output = "ATH0" + Chr$(13) + Chr(10) Ret = comm1.DTREnable 'Save current setting comm1.DTREnable = True 'Turn DTR on DoEvents comm1.DTREnable = False 'Turn DTR off DoEvents comm1.DTREnable = Ret 'Restore old setting comm1.PortOpen = False ErrHndl2: EnableControls Exit Sub End Sub Sub LoadModemSettings () Dim lpReturnedString As String * 100 Dim A As Integer lpReturnedString = Space$(100) A% = GetProfileString("AllTheTime", "TimeZoneIndex", "16", lpReturnedString$, 100) TimeZone.ListIndex = Val(lpReturnedString) A% = GetProfileString("AllTheTime", "DST", "0", lpReturnedString$, 100) DST.Value = Val(lpReturnedString) A% = GetProfileString("AllTheTime", "DialString", "ATDT 1 303 494-4774", lpReturnedString$, 100) DialString.Text = lpReturnedString A% = GetProfileString("AllTheTime", "ComPort", "0", lpReturnedString$, 100) ComPort(Val(lpReturnedString)).Value = True End Sub Sub ResetDefaults () TimeZone.ListIndex = 16 DST.Value = 0 DialString.Text = "ATDT 1 303 494-4774" ComPort(0).Value = True 'LoadModemSettings End Sub Sub SaveModemSettings () Dim A As Integer Dim M As String Dim I As Integer A% = WriteProfileString("AllTheTime", "TimeZoneIndex", TimeZone.ListIndex) A% = WriteProfileString("AllTheTime", "DST", DST.Value) A% = WriteProfileString("AllTheTime", "DialString", DialString.Text) M$ = "0" For I% = 0 To 3 If ComPort(I%).Value Then M$ = Str$(I%) Next I% A% = WriteProfileString("AllTheTime", "ComPort", M$) End Sub